home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ARCHIVES.SWG / 0001_Get Archive ID.pas next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  92 lines
  1. {
  2.  > I'm looking For descriptions of the formats of headers in
  3.  > all popular archive Files, ie .ZIP, .ARC, .LZH, .ARJ, etc.
  4.  > I just want to be able to read the headers of all of these
  5.  > archives, not necessarily manipulate them.  Anyone know
  6.  > where such can be had?
  7.  
  8. Here's a Program that will determine most of the major archive Types.
  9. I've made a couple of additions, but the original source was from
  10. a message on this echo...the original author's name has since been
  11. lost.  To use the Procedure, just call it as follows:
  12.  If GetArcType(FileName.Ext)=Zip then....
  13. }
  14.  
  15. Uses
  16.   Dos;
  17.  
  18. Type
  19.   ArcType = (FileError, Unknown, Zip, Zoo, Arc, Lzh, Pak, Arj);
  20.  
  21. Function GetArcType(FName : String) : ArcType;
  22. Var
  23.   ArcFile : File of Byte;
  24.   i       : Integer;
  25.   Gat     : ArcType;
  26.   c       : Array[1..5] of Byte;
  27. begin
  28.   Assign(ArcFile, FName);
  29.   {$I-}
  30.   Reset(ArcFile);
  31.   {$I+}
  32.   if IOResult <> 0 then
  33.     Gat := FileError
  34.   else
  35.   if FileSize(ArcFile) < 5 then
  36.     Gat := FileError
  37.   else
  38.   begin
  39.     For i := 1 to 5 do
  40.       Read(ArcFile, c[i]);
  41.     Close(ArcFile);
  42.     if ((c[1] = $50) and (c[2] = $4B)) then
  43.       Gat := Zip
  44.     else
  45.     if ((c[1] = $60) and (c[2] = $EA)) then
  46.       Gat := Arj
  47.     else
  48.     if ((c[4] = $6c) and (c[5] = $68)) then
  49.       Gat := Lzh
  50.     else
  51.     if ((c[1] = $5a) and (c[2] = $4f) and (c[3] = $4f)) then
  52.       Gat := Zoo
  53.     else
  54.     if ((c[1] = $1a) and (c[2] = $08)) then
  55.       Gat := Arc
  56.     else
  57.     if ((c[1] = $1a) and (c[2] = $0b)) then
  58.       Gat := Pak
  59.     else
  60.       Gat := Unknown;
  61.   end;
  62.  
  63.   GetArcType := Gat;
  64. end;
  65.  
  66. Var
  67.   FileName : String;
  68.   Return   : ArcType;
  69.   {ArcType = (FileError,Unknown,Zip,Zoo,Arc,Lzh,Pak,Arj)}
  70.  
  71.  
  72. begin
  73.  if ParamCount = 1 then
  74.  begin
  75.    FileName := ParamStr(1);
  76.    Return   := GetArcType(FileName);
  77.    Case Return of
  78.      ARJ     : Writeln(FileName, ' = ARJ ');
  79.      PAK     : Writeln(FileName, ' = PAK ');
  80.      LZH     : Writeln(FileName, ' = LZH ');
  81.      ARC     : Writeln(FileName, ' = ARC ');
  82.      ZOO     : Writeln(FileName, ' = ZOO ');
  83.      ZIP     : Writeln(FileName, ' = ZIP ');
  84.      UNKNOWN : Writeln(FileName, ' = Unknown!')
  85.      else
  86.        Writeln('File Not Found');
  87.    end;
  88.  end {IF}
  89.  else
  90.   Writeln('No parameter');
  91. end.
  92.